home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / XGRAPH.LZH / XGRAPH.PAS < prev    next >
Pascal/Delphi Source File  |  1987-03-12  |  15KB  |  409 lines
  1. { Turbo Pascal XGRAPH suppport definitions, procedures and functions }
  2.  
  3. Const
  4. { Video INT 10H constants }
  5. { ----------------------- }
  6.         VideoInt = $10;
  7.  
  8.  
  9. { Video functions provided by VideoInt }
  10. { ------------------------------------ }
  11.   VidSetMode                      = $00; VidSetCursorType                 = $01;
  12.   VidSetCursorPosition            = $02; VidReadCursorPosition            = $03;
  13.   VidReadLightPenPosition         = $04; VidSelectActiveDisplayPage       = $05;
  14.   VidScrollActivePageUp           = $06; VidScrollActivePageDown          = $07;
  15.   VidReadAtributeCharacterAtCursor= $08; VidWriteAtributeCharacterAtCursor= $09;
  16.   VidWriteCharacterOnlyAtCursor   = $0A; VidSetColorPalette               = $0B;
  17.   VidWriteDot                     = $0C; VidReadDot                       = $0D;
  18.   VidWriteTeletype                = $0E; VidCurrentVideoState             = $0F;
  19.   VidSetPaletteRegisters          = $10; VidCharacterGeneratorRoutine     = $11;
  20.   VidAlternateSelect              = $12; VidWriteString                   = $13;
  21.   VidExtendedFunctions            = $6F;  
  22.   { Xgraph functions }
  23.   VidId                           = $A3; VidInit                          = $A4;
  24.   VidClear                        = $A5; VidRectFill                      = $A6;
  25.   VidLine                         = $A7; VidPolyFill                      = $A8;
  26.   VidBlit                         = $A9;
  27.   { Blit and Texturing Opcodes }
  28.   Blit0       =  0; BlitSandD   =  1; BlitSandND  =  2; BlitS       =  3;
  29.   BlitNSandD  =  4; BlitD       =  5; BlitSxorD   =  6; BlitSorD    =  7;
  30.   BlitNSandND =  8; BlitNSxorD  =  9; BlitND      = 10; BlitSorND   = 11;
  31.   BlitNS      = 12; BlitNSorD   = 13; BlitNSorND  = 14; Blit1       = 15;
  32.  
  33.   Text0      =  0;  Text1      =  1;  TextS      =  2;  TextP      =  3;
  34.   TextSorP   =  4;  TextSandP  =  5;  TextSxorP  =  6;  TextNP     =  7;
  35.   TextSorNP  =  8;  TextSandNP =  9;  TextSxorNP = 10;
  36.  
  37.   
  38. { Video Modes Possible }
  39. { -------------------- }
  40.   Video40x25BW            = $00; Video40x25Color         = $01;
  41.   Video80x25BW            = $02; Video80x25Color         = $03;
  42.   Video320x200BW          = $04; Video320x200Color       = $05;
  43.   Video640x200            = $06; VideoMonochrome         = $07;
  44.   VideoEGA320x200         = $0D; VideoEGA640x200         = $0E;
  45.   VideoEGA640x350Mono     = $0F; VideoEGA640x350Color    = $10;
  46.   VideoHerculesGraphics   = $11;
  47.   VideoMulti80x27         = $12; VideoMulti40x27         = $13;
  48.   VideoMulti640x400       = $14; VideoMulti320x400       = $15;
  49.  
  50. type
  51.   AdapterType = (CGA, Mono, EGAEnh, EGACga, EGAMono, MultiModeHires, MultiModeCga, Hercules);
  52.  
  53.   VidStringType = String[80];
  54.  
  55.   { Record used to invoke INT 10H when needed }
  56.   VidRegs = record
  57.     ax, bx, cx, dx, bp, si, di, ds, es, flags: Integer
  58.   end;
  59.  
  60.   Raster = Record             { Graphics raster descriptor }
  61.     Offset, Segment : integer;
  62.     Width           : integer;
  63.     OrigenX, OrigenY: integer;
  64.     CornerX, CornerY: integer
  65.   end;
  66.  
  67.   FontDescType = Record       { Font graphics descriptor }
  68.     FontRaster : Raster;
  69.     FontWidth  : integer;       
  70.     FontHeight : integer
  71.   end;
  72.   
  73.   BlitParm = Record           { Paramaters passed to Blit function }
  74.     DestOffset, DestSegment : integer;
  75.     SrcOffset, SrcSegment   : integer;
  76.     TextOffset, TextSegment : integer;
  77.     RectOrigenX, RectOrigenY: integer;
  78.     RectCornerX, RectCornerY: integer;
  79.     PointX, PointY          : integer;
  80.     Opcode, TextOp          : integer
  81.   end;
  82.  
  83.   { Data structure describing the video raster }
  84.   GrfDataPtr = ^GraphicsData;
  85.   GraphicsData = record
  86.     { Data returned by a call to XGRAPH function VidInit }
  87.     DestOff, DestSeg        : integer;
  88.     RasterWidth             : integer;
  89.     MinimumX, MinimumY      : integer;
  90.     MaximumX, MaximumY      : integer;
  91.     RowMask, ShiftIntr      : byte;
  92.     HomeOffset, BankOffset  : integer;
  93.     PixelsPByte             : byte;
  94.     TextureOff, TextureSeg  : integer;
  95.     FontFormOff, FontFormSeg: integer;
  96.     Font2FormOff, Font2FormSeg: integer;
  97.  
  98.     { Data that must be initialize base on current video mode and adapter }
  99.     Adapter                 : AdapterType;
  100.     VideoMode               : integer;
  101.     GraphicsOn              : boolean;
  102.     CurrFont              : integer;
  103.     BitPixelDensity         : integer;
  104.     MinX, MinY, MaxX, MaxY  : integer
  105.   end;
  106.  
  107. procedure GraphInit(var GrfData:GraphicsData; ModeSelect : integer);
  108. {
  109.   Called to make a mode change. If ModeSelect equals -1 then the routine
  110.   selects the mode with highest resolutions of the adapter. If
  111.   ModeSelect is equal to one of the possible modes (see table above) and
  112.   the adapter can support it the mode is selected.
  113.  
  114.   After a mode is selected the variables returned from the XGRAPH function
  115.   VidInit are copied into GrfData and the rest of GrfData is initialize
  116.   base on the mode.
  117. }
  118. var LocalRegs : VidRegs;
  119.     GrfPtr : GrfDataPtr;
  120.     LocalAdapter : AdapterType;
  121.     LocalVideoMode : integer;
  122.     corm, mem, switch : integer;
  123.  
  124.   function EGAPresent(var corm, mem, switch:integer):boolean;
  125.   begin
  126.     { Use test suggested on IBM PC seminar proceedings }
  127.     LocalRegs.ax:=$1200; LocalRegs.bx:=$FF10; LocalRegs.cx:=$000F;
  128.     Intr(VideoInt, LocalRegs);
  129.     corm := hi(LocalRegs.bx); mem := lo(LocalRegs.bx);
  130.     switch := lo(LocalRegs.cx);
  131.     if (switch < $0C) and (corm <= $01) and (mem <= $03) then
  132.       EGAPresent := true
  133.     else
  134.       EGAPresent := false;
  135.   end;
  136.  
  137.   function MultiModePresent:boolean;
  138.   { Tests for presence of HP's High resolution adapter }
  139.   begin
  140.     LocalRegs.ax := VidExtendedFunctions shl 8 + $00;
  141.     LocalRegs.bx := $FFFF;
  142.     Intr(VideoInt, LocalRegs);
  143.     if LocalRegs.bx <> $4850 { 'HP' }
  144.       then MultiModePresent := false
  145.       else begin
  146.         LocalRegs.ax := VidExtendedFunctions shl 8 + $01;
  147.         Intr(VideoInt, LocalRegs);
  148.         if lo(LocalRegs.ax) = $41
  149.           then MultimodePresent := true
  150.           else MultimodePresent := false;
  151.       end;
  152.   end;
  153.  
  154.   function CGAPresent:boolean;
  155.   var crt : integer;
  156.   begin
  157.     Port[$3d4] := $0F;
  158.     crt := Port[$3d5];
  159.     Port[$3d5]:=$55;
  160.     delay(100);
  161.     if Port[$3d5] = $55 then begin
  162.       CGAPresent := true;
  163.       Port[$3d5] := crt end
  164.     else CGAPresent:=false;
  165.   end;
  166.  
  167. begin
  168.   { Find out type of Video Adapter }
  169.   if EGAPresent(corm,mem,switch) then begin
  170.     if corm = $01 then { EGA attached to monochrome monitor }
  171.       LocalAdapter :=  EGAMono
  172.     else { EGA attached to color monitor }
  173.       if (mem > 0) and (switch = $09) then { EGA and Enhanced monitor }
  174.         LocalAdapter := EGAEnh
  175.       else { EGA and CGA monitor }
  176.         LocalAdapter := EGACga
  177.   end
  178.   else if MultiModePresent then begin
  179.     if (Port[$3DA] and $10)=0 then { Test for 400 line monitor }
  180.       LocalAdapter := MultiModeHires
  181.     else
  182.       LocalAdapter := MultiModeCga;
  183.   end
  184.   else if CGAPresent then begin
  185.     LocalAdapter := CGA
  186.   end
  187.   else begin { Add Hercules presence test here }
  188.     LocalAdapter := Mono
  189.   end;
  190.  
  191.   { See if mode selected is appropiate for Adapter monitor combo }
  192.   case LocalAdapter of
  193.     CGA, MultiModeCga:  begin
  194.       if not(ModeSelect in [Video320x200BW .. Video640x200]) then
  195.         ModeSelect:=Video640x200;
  196.       LocalRegs.ax := VidSetMode shl 8 + ModeSelect;
  197.     end;
  198.     EGACga : begin
  199.       if not(ModeSelect in
  200.                [Video320x200BW .. Video640x200, VideoEGA320x200 .. VideoEGA640x200])
  201.                then ModeSelect:=VideoEGA640x200;
  202.       LocalRegs.ax := VidSetMode shl 8 + ModeSelect;
  203.     end;
  204.     EGAEnh : begin
  205.       if not(ModeSelect in
  206.                [Video320x200BW..Video640x200, VideoEGA320x200..VideoEGA640x200,
  207.                 VideoEGA640x350Color]) then ModeSelect:=VideoEGA640x350Color;
  208.       LocalRegs.ax := VidSetMode shl 8 + ModeSelect;
  209.     end;
  210.     EGAMono: begin
  211.       if ModeSelect <> VideoEGA640x350Mono then
  212.                ModeSelect:=VideoEGA640x350Mono;
  213.       LocalRegs.ax := VidSetMode shl 8 + ModeSelect;
  214.     end;
  215.     MultiModeHires: begin
  216.       if not(ModeSelect in [Video320x200BW..Video640x200,
  217.         VideoMulti640x400..VideoMulti320x400]) then
  218.         ModeSelect:=VideoMulti640x400;
  219.       LocalRegs.ax := VidExtendedFunctions shl 8 + $05;
  220.       If ModeSelect = VideoMulti640x400 then LocalRegs.bx:=$0D
  221.         else if ModeSelect = VideoMulti320x400 then LocalRegs.bx:=$0E
  222.       else LocalRegs.bx := ModeSelect;
  223.     end;
  224.     Hercules: begin
  225.       ModeSelect:=VideoHerculesGraphics;
  226.       { Call procedure to put it on Herc graphics mode here }
  227.     end;
  228.     else { Unknow video adapter and mode }
  229.       ModeSelect := -1;
  230.   end;
  231.  
  232.   { Put it in the appropiate video mode }
  233.   if (LocalAdapter in
  234.        [CGA, EGACga, EGAEnh, EGAMono, MultiModeHires, MultiModeCga])
  235.      and (ModeSelect<>-1) then
  236.     Intr(VideoInt, LocalRegs);
  237.  
  238.   { After the mode is selected, Initialize XGRAPH internal data structures }
  239.   LocalRegs.ax := VidInit shl 8; Intr(VideoInt, LocalRegs);
  240.   GrfPtr := Ptr(LocalRegs.es, LocalRegs.di);
  241.  
  242.   { and copy it to our local area, and initializing rest of variables }
  243.   GrfData := GrfPtr^;
  244.  
  245.   { Calculate density of bits to pixels and actual screen size in pixels }
  246.   with GrfData do begin
  247.     if PixelsPByte in [0,1,2,3] then  { Calculate pixel/bit density        }
  248.       case PixelsPByte of             { because VidLine operates in pixels }
  249.         3 : BitPixelDensity := 1;     { and VidBlit operates in bits.      }
  250.         2 : BitPixelDensity := 2;
  251.         1 : BitPixelDensity := 4;
  252.         0 : BitPixelDensity := 8
  253.       end
  254.     else BitPixelDensity := 1;
  255.     MinX := MinimumX div BitPixelDensity; MaxX := MaximumX div BitPixelDensity;
  256.     MinY := MinimumY; MaxY := MaximumY;
  257.     Adapter := LocalAdapter;
  258.     VideoMode := ModeSelect;
  259.     if ModeSelect <> -1 then GraphicsOn:=true else GraphicsOn:=false;
  260.     if MaxY > 199 then CurrFont:=2 else CurrFont:=1;
  261.   end;
  262. end;
  263.  
  264. procedure WriteChar(ch : char; X, Y: integer; GrfData:GraphicsData);
  265. {
  266.   Writes a character to raster using the BitBlit procedure and one of
  267.   the build-in fonts (FontNum=1 => use 8x8, FontNum=2 => use 8x14).
  268. }
  269. var FontPtr : ^FontDescType;
  270.     LocalBlitParms : BlitParm;
  271.     LocalRegs : VidRegs;
  272. begin
  273.   with LocalBlitParms do begin
  274.     DestOffset := ofs(GrfData); DestSegment := seg(GrfData);
  275.     if GrfData.CurrFont = 2 then                           
  276.       FontPtr := Ptr(GrfData.Font2FormSeg,GrfData.Font2FormOff)
  277.     else
  278.       FontPtr := Ptr(GrfData.FontFormSeg,GrfData.FontFormOff);
  279.     SrcOffset := ofs(FontPtr^.FontRaster);
  280.     SrcSegment := seg(FontPtr^.FontRaster);
  281.     RectOrigenX := X; RectOrigenY := Y;
  282.     RectCornerX := X + FontPtr^.FontWidth-1;
  283.     RectCornerY := Y + FontPtr^.FontHeight-1;
  284.     PointX := ord(ch) * FontPtr^.FontWidth; PointY := 0;
  285.     Opcode := BlitS; TextOp := TextS;
  286.   end;
  287.   LocalRegs.ax := VidBlit shl 8;
  288.   LocalRegs.ds := seg(LocalBlitParms); LocalRegs.si := ofs(LocalBlitParms);
  289.   LocalRegs.bx := $000F; Intr(VideoInt, LocalRegs);
  290. end; { of WriteChar }  
  291.  
  292. procedure WriteStr(Strng:VidStringType; X, Y:integer; GrfData:GraphicsData);
  293. {
  294.   Write the given string at (X,Y). Clipping is done by blit if it does
  295.   not fit on the screen.
  296. }
  297. var i : integer;
  298.     FontPtr : ^FontDescType;
  299.     LocalBlitParms : BlitParm;
  300.     LocalRegs : VidRegs;
  301. begin
  302.   { Set up all parameters before going into loop }
  303.   with LocalBlitParms do begin
  304.     DestOffset := ofs(GrfData); DestSegment := seg(GrfData);
  305.     if GrfData.CurrFont= 2 then
  306.       FontPtr := Ptr(GrfData.Font2FormSeg,GrfData.Font2FormOff)
  307.     else
  308.       FontPtr := Ptr(GrfData.FontFormSeg,GrfData.FontFormOff);
  309.     SrcOffset := ofs(FontPtr^.FontRaster);
  310.     SrcSegment := seg(FontPtr^.FontRaster);
  311.     RectOrigenX := X; RectOrigenY := Y;
  312.     RectCornerX := X + FontPtr^.FontWidth-1;
  313.     RectCornerY := Y + FontPtr^.FontHeight-1;
  314.     PointY := 0; Opcode := BlitS; TextOp := TextS;
  315.   end;
  316.   LocalRegs.ax := VidBlit shl 8;
  317.   LocalRegs.ds := seg(LocalBlitParms); LocalRegs.si := ofs(LocalBlitParms);
  318.   LocalRegs.bx := $000F;    
  319.   { Execute a call to blit per character in string and update X position }
  320.   for i:=1 to ord(Strng[0]) do with LocalBlitParms do begin
  321.     PointX := ord(Strng[i]) * FontPtr^.FontWidth; Intr(VideoInt, LocalRegs);
  322.     RectOrigenX := RectOrigenX + FontPtr^.FontWidth;
  323.     RectCornerX := RectCornerX + FontPtr^.FontWidth;
  324.   end;
  325. end; { of WriteStr }
  326.  
  327. procedure WriteInt(Value, X, Y : integer;
  328.                    Base, Width : integer;
  329.                    LeftJustify : Boolean;
  330.                    GrfData     : GraphicsData );
  331. {
  332.   Writes an integer to the screen at location (X,Y), in the given Base,
  333.   within a field of Width and left of right justified. If the number is
  334.   bigger than the field the Width and LeftJustify parameters are ignored.
  335.   Legal bases are 2, 8, 10, 16. Any other base is ignored.
  336. }
  337. var i, temp, Select, Shift, ShiftDec : integer;
  338.     Strng : string[16];
  339. begin
  340.   Strng := '';
  341.   if Base = 10 then Str(Value,Strng)
  342.   else if Base in [2,8,16] then begin
  343.     case Base of
  344.       2 : begin Select:=$8000; Shift:=15; ShiftDec:=1 end;
  345.       8 : begin
  346.             if Value < 0 then Strng := Strng+'1'
  347.                          else Strng := Strng+'0';
  348.             Select:=$7000; Shift:=12; ShiftDec:=3
  349.           end;
  350.      16 : begin Select:=$F000; Shift:=12; ShiftDec:=4 end
  351.     end;
  352.     while Shift >= 0 do begin
  353.       Temp := (Value and Select) shr Shift;
  354.       Strng[0] := succ(Strng[0]);
  355.       if Temp in [0..9] then
  356.         Strng[ord(Strng[0])] := chr(ord('0')+temp)
  357.       else
  358.         Strng[ord(Strng[0])] := chr(ord('A')+temp-10);
  359.       Select := Select shr ShiftDec; Shift := Shift - ShiftDec;
  360.     end
  361.   end;
  362.  
  363.   if (not LeftJustify) and (Length(Strng) < Width) then
  364.     for i:=1 to (Width - Length(Strng)) do begin
  365.       WriteChar(' ',X,Y,GrfData); X:=X+8;
  366.     end;
  367.  
  368.   WriteStr(Strng, X, Y, GrfData);
  369.   X := X + (Length(Strng) shl 3);
  370.  
  371.   if LeftJustify and (Length(Strng) < Width) then
  372.     for i:=1 to (Width - Length(Strng)) do begin
  373.       WriteChar(' ',X,Y,GrfData); X:=X+8;
  374.     end;
  375. end;
  376.  
  377. procedure ReadStr(var Inp:VidStringType; x,y:integer; GrfData:GraphicsData);
  378. {
  379.   Reads a string at the given bit position on the screen. It recognizes
  380.   Backspace and carriage return as specials characters. It treats every
  381.   thing else as part of the string.
  382. }
  383. const
  384.   CR = 13; BS = 8;
  385. var
  386.   c : char; i : integer;
  387.   LocX, LocY : integer;
  388. begin
  389.   Inp := ''; LocX := x; LocY:=y;
  390.   repeat
  391.     WriteChar(chr($DB),LocX,LocY,GrfData);
  392.     read(kbd,c);
  393.     if (c = chr(BS)) and (ord(Inp[0])>0) then begin
  394.       WriteChar(' ',LocX,LocY,GrfData);
  395.       if LocX > x then LocX := LocX - 8;
  396.       Inp[0]:=pred(Inp[0]);
  397.     end
  398.     else if (c <> chr(CR)) and (c <> chr(BS)) then begin
  399.       WriteChar(c,LocX,LocY,GrfData);
  400.       if (LocX+8) < (GrfData.MaximumX) then LocX:=LocX+8;
  401.       if (ord(Inp[0]) < 80) then begin
  402.         Inp[0] := succ(Inp[0]);
  403.         Inp[ord(Inp[0])]:=c;
  404.       end;
  405.     end;
  406.   until (c = chr(CR));
  407.   WriteChar(' ',LocX,LocY,GrfData);
  408. end; { of ReadStr }
  409.